home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch14 / Valley.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-22  |  8KB  |  261 lines
  1. VERSION 5.00
  2. Begin VB.Form frmValley 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Valley"
  6.    ClientHeight    =   5295
  7.    ClientLeft      =   300
  8.    ClientTop       =   570
  9.    ClientWidth     =   9135
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    KeyPreview      =   -1  'True
  21.    LinkTopic       =   "Form1"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   5295
  24.    ScaleWidth      =   9135
  25.    Begin VB.CommandButton cmdDraw 
  26.       Caption         =   "Draw"
  27.       Default         =   -1  'True
  28.       Height          =   375
  29.       Left            =   1320
  30.       TabIndex        =   6
  31.       Top             =   480
  32.       Width           =   735
  33.    End
  34.    Begin VB.TextBox txtDy 
  35.       Height          =   285
  36.       Left            =   720
  37.       TabIndex        =   4
  38.       Text            =   "0.25"
  39.       Top             =   720
  40.       Width           =   495
  41.    End
  42.    Begin VB.TextBox txtLevel 
  43.       Height          =   285
  44.       Left            =   720
  45.       TabIndex        =   3
  46.       Text            =   "3"
  47.       Top             =   360
  48.       Width           =   495
  49.    End
  50.    Begin VB.CheckBox chkRemoveHidden 
  51.       Caption         =   "Remove Hidden"
  52.       Height          =   255
  53.       Left            =   240
  54.       TabIndex        =   1
  55.       Top             =   0
  56.       Value           =   1  'Checked
  57.       Width           =   1695
  58.    End
  59.    Begin VB.PictureBox picCanvas 
  60.       AutoRedraw      =   -1  'True
  61.       Height          =   5295
  62.       Left            =   2160
  63.       ScaleHeight     =   349
  64.       ScaleMode       =   3  'Pixel
  65.       ScaleWidth      =   461
  66.       TabIndex        =   0
  67.       Top             =   0
  68.       Width           =   6975
  69.    End
  70.    Begin VB.Label Label1 
  71.       Caption         =   "Dy"
  72.       Height          =   255
  73.       Index           =   1
  74.       Left            =   120
  75.       TabIndex        =   5
  76.       Top             =   720
  77.       Width           =   495
  78.    End
  79.    Begin VB.Label Label1 
  80.       Caption         =   "Level"
  81.       Height          =   255
  82.       Index           =   0
  83.       Left            =   120
  84.       TabIndex        =   2
  85.       Top             =   360
  86.       Width           =   495
  87.    End
  88. Attribute VB_Name = "frmValley"
  89. Attribute VB_GlobalNameSpace = False
  90. Attribute VB_Creatable = False
  91. Attribute VB_PredeclaredId = True
  92. Attribute VB_Exposed = False
  93. Option Explicit
  94. ' Location of viewing eye.
  95. Private EyeR As Single
  96. Private EyeTheta As Single
  97. Private EyePhi As Single
  98. Private Const Dtheta = PI / 20
  99. Private Const Dphi = PI / 20
  100. Private Const Dr = 1
  101. ' Location of focus point.
  102. Private Const FocusX = 0#
  103. Private Const FocusY = 0#
  104. Private Const FocusZ = 0#
  105. Private Projector(1 To 4, 1 To 4) As Single
  106. Private TheGrid As ValleyGrid3d
  107. Private Const Xmin = -5
  108. Private Const Zmin = -5
  109. ' Return the Y coordinate for these X and
  110. ' Z coordinates.
  111. Private Function YValue(ByVal X As Single, ByVal Z As Single)
  112. Dim Y As Single
  113.     Y = -2 * Cos(2 * PI / 10 * Z) * (5 - Abs(Z)) / 5 + 0.25 * Sin(2 * X) + 0.25 * Sin(1# * X) + 0.5 * Rnd
  114.     If Y < -1 Then Y = -1
  115.     YValue = Y
  116. End Function
  117. ' Project and display the data.
  118. Private Sub DrawData(pic As Object)
  119. Dim X As Single
  120. Dim Y As Single
  121. Dim Z As Single
  122. Dim S(1 To 4, 1 To 4) As Single
  123. Dim T(1 To 4, 1 To 4) As Single
  124. Dim ST(1 To 4, 1 To 4) As Single
  125. Dim PST(1 To 4, 1 To 4) As Single
  126.     MousePointer = vbHourglass
  127.     DoEvents
  128.     ' Make the data.
  129.     CreateData
  130.     ' Scale and translate so it looks OK in pixels.
  131.     m3Scale S, 35, -35, 1
  132.     m3Translate T, 230, 175, 0
  133.     m3MatMultiplyFull ST, S, T
  134.     m3MatMultiplyFull PST, Projector, ST
  135.     ' Transform the points.
  136.     TheGrid.ApplyFull PST
  137.     ' Prevent overflow errors when drawing lines
  138.     ' too far out of bounds.
  139.     On Error Resume Next
  140.     ' Display the data.
  141.     pic.Cls
  142.     TheGrid.RemoveHidden = (chkRemoveHidden.value = vbChecked)
  143.     TheGrid.Draw pic
  144.     pic.Refresh
  145.     MousePointer = vbDefault
  146. End Sub
  147. Private Sub cmdDraw_Click()
  148.     DrawData picCanvas
  149. End Sub
  150. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  151.     Select Case KeyCode
  152.         Case vbKeyLeft
  153.             EyeTheta = EyeTheta - Dtheta
  154.         
  155.         Case vbKeyRight
  156.             EyeTheta = EyeTheta + Dtheta
  157.         
  158.         Case vbKeyUp
  159.             EyePhi = EyePhi - Dphi
  160.         
  161.         Case vbKeyDown
  162.             EyePhi = EyePhi + Dphi
  163.                 
  164.         Case Else
  165.             Exit Sub
  166.     End Select
  167.     m3PProject Projector, m3Parallel, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  168.     DrawData picCanvas
  169. End Sub
  170. Private Sub Form_KeyPress(KeyAscii As Integer)
  171.     Select Case KeyAscii
  172.         Case Asc("+")
  173.             EyeR = EyeR + Dr
  174.         
  175.         Case Asc("-")
  176.             EyeR = EyeR - Dr
  177.         
  178.         Case Else
  179.             Exit Sub
  180.     End Select
  181.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  182.     DrawData picCanvas
  183. End Sub
  184. Private Sub Form_Load()
  185.     Randomize
  186.     ' Initialize the eye position.
  187.     EyeR = 10
  188.     EyeTheta = PI * 0.2
  189.     EyePhi = PI * 0.1
  190.     ' Initialize the projection transformation.
  191.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  192.     ' Project and draw the data.
  193.     Me.Show
  194.     DrawData picCanvas
  195. End Sub
  196. ' Create the surface.
  197. Private Sub CreateData()
  198. Const Dx = 1
  199. Const Dz = 1
  200. Const NumX = -2 * Xmin / Dx
  201. Const NumZ = -2 * Zmin / Dz
  202. Dim i As Integer
  203. Dim j As Integer
  204. Dim X As Single
  205. Dim Y As Single
  206. Dim Z As Single
  207. Dim level As Integer
  208. Dim Dy As Single
  209. Dim small_dx As Single
  210. Dim small_dz As Single
  211. Dim min_z As Single
  212. Dim max_z As Single
  213. Dim river_width As Single
  214. Dim period1 As Single
  215. Dim period2 As Single
  216. Dim period3 As Single
  217.     Set TheGrid = New ValleyGrid3d
  218.     TheGrid.SetBounds Xmin, Dx, NumX, Zmin, Dz, NumZ
  219.     X = Xmin
  220.     For i = 1 To NumX
  221.         Z = Zmin
  222.         For j = 1 To NumZ
  223.             Y = YValue(X, Z)
  224.             TheGrid.SetValue X, Y, Z
  225.             Z = Z + Dz
  226.         Next j
  227.         X = X + Dx
  228.     Next i
  229.     On Error Resume Next
  230.     level = CInt(txtLevel.Text)
  231.     If Err.Number <> 0 Then
  232.         txtLevel.Text = "3"
  233.         level = 3
  234.     End If
  235.     Dy = CSng(txtDy.Text)
  236.     If Err.Number <> 0 Then
  237.         txtDy.Text = "0.25"
  238.         Dy = 0.25
  239.     End If
  240.     TheGrid.GenerateSurface level, Dy
  241.     ' Flatten the bottom.
  242.     TheGrid.Flatten -1, 0.25, 0.25
  243.     ' Make a river bed in the bottom.
  244.     period1 = 0.5 + Rnd * 1
  245.     period2 = 0.5 + Rnd * 1
  246.     period3 = 0.5 + Rnd * 1
  247.     small_dx = Dx / (2 ^ level)
  248.     small_dz = Dz / (2 ^ level)
  249.     X = Xmin
  250.     For i = 1 To NumX * (2 ^ level) - (2 ^ level - 1)
  251.         river_width = Abs(Sin(X / 3) * Rnd / 2 + Sin(X / 2.5) * Rnd / 3 - Sin(X) * Rnd / 4) + 1 / 8
  252.         If river_width < 2 * small_dx Then river_width = 2 * small_dx
  253.         min_z = Sin(X / period1) / 2 + Sin(X / period2) / 4 - Sin(X / period3) / 8
  254.         max_z = min_z + river_width
  255.         For Z = min_z To max_z Step small_dz
  256.             TheGrid.SetValue X, -1.1, Z
  257.         Next Z
  258.         X = X + small_dx
  259.     Next i
  260. End Sub
  261.